C******* SUBRS  TAIL, FERMTA, REST, RDDATA, BREP, EXCH, SORT2, ALPHA
	SUBROUTINE TAIL(RJX,RA,RMINI)
	COMMON /STF/RSTFAC(8),RSTJC
	COMMON /PLTR/IPLT,RHT,DIS
	DIMENSION ITAIL(16)
	DATA ITAIL/16,100090007,110012,120016,200120016,120019,100026,
	1 80030,20036, 40, 33, 30031, 50029,80025,100022,120016/
	Q=-1.
	IF(RA)Q=1.
	CALL CENTER(RJY)
	CALL JDRAW(ITAIL(1),RJX,RJY,RMINI,1.,Q)
1	IF(IPLT.GE.0)RETURN
	IF(RMINI.NE.RSTJC)Q=Q*.6
CC	CALL OLDFIL(ITAIL(10),RJX,RJY,ABS(Q),Q)
	CALL FILLMS(ITAIL(1),ITAIL(5),RJX,RJY,ABS(Q),Q)
C RA=-,STEM UP;  RA=+, STEM DOWN.
	END

	SUBROUTINE REST
	COMMON /STF/RSTFAC(8),RSTJC
	COMMON /PLTR/IPLT,RHT,DIS
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE(JE,JQ(3))
	DIMENSION LRST(4),IRST(74)

	IF(LRST(1).EQ.0)CALL RDDATA('REST',LRST,IRST)
	L=JE
	IF(L.GT.1)L=1
	K=LRST(L+3)
C  L>3 WHEN SEVERAL TAILS ON REST
	CALL CENTER(CENTR)
	CALL JDRAW(IRST(K),RJB,CENTR,RSTJC,1.,1.)
	IF(JE.OR.IPLT.GE.0)RETURN
	CALL OLDFIL(IRST(IRST(K)+K+1),RJB,CENTR,1.,1.)
C  WHY GO THROUGH NOTWRT??
	END

	SUBROUTINE RDDATA(NM,JARY,IARY)
C  READS DATA 
	DIMENSION JARY(1),IARY(1)
	REWIND 23
	CALL IFILE(23,NM)
	READ(23,5)K,(JARY(K),K=1,10)
	N=1
1	READ(23,5,END=2)K,L,(IARY(K),K=N,N+L-1)
	N=N+L
	GO TO 1
2	RETURN
5	FORMAT(12I)
	END

C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
	SUBROUTINE BREP(RJB,RSTJC)
	DIMENSION JREP(1),IREP(35)
	DATA IREP/35,100000015,280043,290043, 10015, 20015, 300043,310043
	1,30015, 40015, 320043,100020037, 30038, 40038, 50037
	1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
	1,100270022,280021,290021,300022,300023,290024,280024,270023
	1,270022, 300022, 270023, 290023/
CC	IF(JREP(1).EQ.0)CALL RDDATA('BREP',JREP,IREP)
	CALL CENTER(R)
	CALL JDRAW(IREP,RJB,R,RSTJC,1.,1.)
	END

	SUBROUTINE FERMTA(RINV)
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON /PLTR/IPLT,RHT,DIS
	COMMON /STF/RSTFAC(8),RSTJC
	DIMENSION JFERM(24)
	DATA JFERM/24,310020003,10010010,20015,60017,110017,160015,
	1 190010,200003,170010,150012,120014,70014,30012,10010,
	1 10020003,100070007,80008,100008,110007,110006,100005,80005
	1 ,70006/
CC	IF(JFERM(1).EQ.0)CALL RDDATA('FERM',JFERM,IFERM)
CC	R=INV
	CALL JDRAW(JFERM,RJB,CENTR,RSTJC,1.,RINV)
CC	IF(IPLT)CALL OLDFIL(IFERM(IFERM(1)+2),RJB,CENTR,1.,RINV)
	IF(IPLT)CALL FILLMS(JFERM(1),JFERM(2),RJB,CENTR,1.,RINV)
	END

	SUBROUTINE EXCH(X,Y)
	Z=X
	X=Y
	Y=Z
	END
	SUBROUTINE SORT2(RPOS,M)
	DIMENSION RPOS(2,200)
	L=2
3	J=-1
	RX=RPOS(1,L-1)
	DO 2 K=L,M
	IF(RPOS(1,K).GE.RX)GO TO 2
	RX=RPOS(1,K)
C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
	J=K
2	CONTINUE
	IF(J)GO TO 4
	K=L-1
	CALL EXCH(RPOS(1,K),RPOS(1,J))
	CALL EXCH(RPOS(2,K),RPOS(2,J))
4	L=L+1
	IF(L.LE.M)GO TO 3
	END

C****** FOR LISTS OF LETTERS, ETC. *******
	SUBROUTINE ALPHA
	COMMON /PLTR/IPLT,RHT,DIS
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
       EQUIVALENCE(JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3)),
	1(RJH,RJQ(6)),(NRJ,RJQ(8)),
	1(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
	1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
	COMMON/STF/RSTFAC(8),RSTJC
	DATA RS/1.1/,R4/-2.1/,RSPC/.9/,JFIX/-1/

	IF(JA.EQ.20)GO TO 20
CC	IFNT=0
C  PRIMITIVE IS DEFAULT FONT.  #=SET BACK TO PRIM.
C ONLY 11 LETTERS WITHOUT FONT RESET.
CC	JA=5
54	R=19.7*RJE*RSTJC
	RB=JB
CC	J=R
CC	RND=R-J
CC	R=0
CC	RSX=RS
	DO 50 KA=4,6
	JY=RJQ(KA)*100.+.2
	JX=1000000
	DO 53 LA=1,4
	JF=JY/JX
	IF(JF.EQ.47.OR.JF.GT.90)GO TO 2
	IF(JF.LT.47.AND.IFNT.EQ.0)GO TO 3
C  JUMP TO USE PRIMITIVE ALPHABET.
CC	RS=RSX
	IF((JF.GT.9.AND.JF.LT.36).OR.JF.GT.47)GO TO 10
C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
CC	RSX=RS
	RSX=RSPC
	IF(JF.GT.9)GO TO 3
	GO TO 4
10	IF(JF.LT.47)GO TO 5
	IF(JF.NE.48)GO TO 7
	IFNT=1
C  $=48=UPPER CASE
CC	RSX=1.1
	GO TO 11
7	IF(JF.NE.49)GO TO 8
	IFNT=-1
C  %=LOWER CASE
CC	RSX=.73
	GO TO 11
8	IF(JF.NE.50)GO TO 13
	NR='BDR40'
CC	IF(JFIX)NR='FIX40'
C  &=NON-ITALICS  --  JFIX IS TEMPORARY SWITCH  5/74
13	IF(JF.NE.51)GO TO 14
	NR='BDI40'
CC	IF(JFIX)NR='FIZ40'
C  @=51=ITALICS
14	IF(JF.NE.52)GO TO 11
	IFNT=0
C  #=52=PRIMITIVE
	JA=5
	RSX=1.
	GO TO 11
9	IF(JF.LT.52)GO TO 11
	IF(JF.EQ.53)FILL=-2
	IF(JF.EQ.54)FILL=0
C  < = 53 = NO FILL,   > = 54 = FILL
	GO TO 11
5	IF(IFNT)RSX=.8
	IF(JF.LE.9)RSX=RSPC
	IF(JF.EQ.22.OR.JF.EQ.32)RSX=RSX*1.1
	IF(JF.EQ.1.OR.JF.EQ.18.OR.JF.EQ.19.OR.(JF.EQ.21.AND.IFNT))
	1 RSX=RSX*.8
4	IF(JFIX.AND.IPLT.GE.0)GO TO 3
C  JFIX=-1 FOR FIXED WIDTH OF FONTS.  = AND ONLY DPYS PRIMITIVE.
C******** SET JFIX TO -1 IN DDT TO USE FIXED WIDTH.
	JE=JF
	IF(IFNT.AND.JE.GT.9)JE=JE+26
	RX=RJF
	RJF=RJE*.28
C  .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
	RY=RJG
	RJG=RJF
	RZ=RJH
	RW=RJD
	RJD=RJD+R4
	RJH=FILL
	NRJ=NR
C  GETS RIGHT FILE
	JA=11
	CALL NOTWRT
	RJF=RX
	RJG=RY
	RJH=RZ
	RJD=RW
C  PUTS BACK RIGHT STUFF
	IF(JFIX)GO TO 12
	GO TO 2

3	JA=5
	CALL NOTWRT
C  47=BLANK  (WAS 99)
CC2	JB=JB+J
12	RSX=1.
2	RB=RB+R*RSX
	JB=ROFF(RB)
CC	R=R+RND
CC	IF(R.LT.1.0)GO TO 11
CC	JB=JB+1
CC	R=R-1.0
11	JY=JY-JF*JX
	RSX=RS
53	JX=JX/100
50	CONTINUE
	RETURN

C  FOR TRILLS
20	R=RJB
C  R SAVES RJB(WHICH GETS CLOBBERED WHEN 'TR' IS WRITTEN.)
C 20, POS1, STF, NT#, 0, POS2, X     IF X=1 THEN NO WAVEY LINE
	RJE=.65
	JE=0
	JA=5
	JF=29
C   DRAWS T
	CALL NOTWRT
	JF=27
C   DRAWS R
	JB=JB+11*RSTJC
51	CALL NOTWRT
	IF(JG.NE.0)RETURN
	JB=JB+16*RSTJC
C   RETURN IF NO WAVY LINE IS NEEDED
	JA=4
	RJB=R+4.*RSTJC
	JG=-2
C  JG IS SWITCH TO DRAW WIGGLE
	RJE=RJD+.8
	CALL ITMSUB
	END